0010 REM "XFRM2K -- MAI 2000 to PVX communications transfer program"
0020 REM 
0030 REM "(c) Copyright 1988-1997, Sybex Ltd (Ontario, Canada)"
0040 REM ""
0050 BEGIN 
0060 GOSUB 0450
0070 LET O$="L"; GOSUB 0490; GOSUB 0540; LET V$=X1$
0080 IF V$="" THEN GOTO 0150
0090 LET O$="M"; GOSUB 0490; GOSUB 0540; LET V2$=X1$
0100 LET O$="F"; GOSUB 0490; GOSUB 0540; LET V1$=X1$
0110 OPEN (3,ERR=0130)V$
0120 GOTO 0150
0130 LET V1$="ERROR="+STR(ERR); LET O$="!"; GOSUB 0490; LET O$=V1$; GOSUB 0490
0140 GOTO 0420
0150 IF V$<>"" THEN GOTO 0180
0160 LET O$="F"; GOSUB 0490; GOSUB 0540; LET P$=X1$
0170 IF P$="" THEN GOTO 0420 ELSE GOTO 0230
0180 READ (3,END=0420)P$
0190 LET P$=P$(1,POS(" "=P$+" ")-1)
0200 IF V1$<>"" THEN IF P$<>V1$ THEN GOTO 0180 ELSE LET V1$=""
0210 LET X=POS("/"=P$); IF X<>0 THEN LET P$=P$(X+1); GOTO 0210
0220 IF P$>V2$ THEN GOTO 0420
0230 REM "500 - TRANSMIT FILE"
0240 WAIT 1
0250 OPEN (2,ERR=0400)P$
0260 LET O1$=""
0270 LET F$=FID(2)
0280 LET K=DEC(F$(11,1)),R=DEC(F$(15,2)),N=DEC(F$(12,3))
0290 IF K=0 THEN GOTO 0310
0300 REM IF N>32167 THEN LET K=K-6 ELSE LET K=K-4
0310 IF AND($0F$,F$(10,1))=$04$ THEN LET R=0,K=0,N=0
0320 IF F$(10,1)=$01$ OR F$(10,1)=$07$ THEN LET K1$="SE" ELSE LET K1$=STR(K:"00")
0330 LET K$=P$+"        ",O$=K$(1,8)+STR(R:"0000")+K1$+STR(N:"000000")
0340 GOSUB 0490
0350 LET F1$=HTA(F$(10,1)); IF F1$(2,1)="4" THEN GOSUB 0720 ELSE GOSUB 0950
0360 IF O1$="" THEN LET O$="*"; GOSUB 0490
0370 GOSUB 0540
0380 CLOSE (2)
0390 GOTO 0150
0400 REM "800 - ERROR OPENING FILE"
0410 GOSUB 0700; GOTO 0360
0420 REM "900 - END OF SESSION"
0430 GOSUB 0660
0440 STOP 
0450 REM "1000- PREPARE COM"
0460 DIM B$(4000)
0470 LET B1=1,B$(1,4)="0001",B=11
0480 RETURN 
0490 REM "1100 - WRITE RECORD"
0500 LET U=LEN(O$)+4
0510 IF U+B>2000 THEN GOSUB 0540
0520 LET B$(B,U)=STR(U-4:"0000")+O$,B=B+U
0530 RETURN 
0540 REM "1200 - FLUSH BLOCK"
0550 LET B$(5,4)=STR(B-1:"0000"),B$(9,2)=HTA(LRC(B$(11,B-11)))
0560 LET B2=1
0570 IF B-B2<75 THEN GOTO 0600
0580 PRINT "{",B$(B2,75),"}+"
0590 LET B2=B2+75; GOTO 0570
0600 PRINT "{",B$(B2,B-B2),"}?"
0610 INPUT (0,TIM=50,ERR=0560)'CI',X$
0620 IF LEN(X$)>1 THEN LET X1$=X$(2),X$=X$(1,1) ELSE LET X1$=""
0630 IF X$<>"Y" THEN WAIT 2; GOTO 0560
0640 IF B1=9999 THEN LET B1=0 ELSE LET B1=B1+1
0650 LET B$(1,5)=STR(B1:"0000"),B=11; RETURN 
0660 REM "1300 - CLOSE/FLUSH COMM"
0670 IF B<>11 THEN GOSUB 0540
0680 GOSUB 0540
0690 RETURN 
0700 REM "1900 - SEND ERROR MESSAGES"
0710 LET O1$="ERROR #"+STR(ERR); LET O$="!"; GOSUB 0490; LET O$=O1$; GOTO 0490
0720 REM "2000 - DEBLOCK PROGRAMS"
0730 CLOSE (2)
0740 LET VTBL$=""; CALL "/util/OPNTBL",P$,2,VTBL$
0750 CLOSE (2); OPEN (2,ISZ=256)P$
0760 READ RECORD (2)R$
0770 LET O=17+DEC(R$(17,2))
0780 IF DEC(R$(5,4))<62 THEN RETURN 
0790 IF LEN(R$(O))<2 THEN GOSUB 0910
0800 LET L=DEC($00$+R$(O,2))
0810 IF LEN(R$(O))<L THEN GOSUB 0910; GOTO 0810
0820 IF R$(O,L)=$0005FFFF43$ THEN RETURN 
0830 SETERR 0700
0840 LET O$=LST(R$(O,L),VTBL$)
0850 SETERR 0000
0860 IF O$(1,5)="  END" OR O$(1,4)=" END" THEN RETURN 
0870 IF O$="  END" THEN RETURN 
0880 IF O$="!" THEN RETURN 
0890 GOSUB 0490
0900 LET O=O+L; GOTO 0790
0910 REM "2500 - READ NEXT"
0920 READ RECORD (2,ERR=0940)R1$
0930 LET R$=R$(O)+R1$; LET O=1; RETURN 
0940 EXITTO 0700; REM "POP STACK AND RETURN ERROR"
0950 REM "3000 - EXTRACT DATA FILE"
0960 DIM Z$(R,$00$)
0970 IF K<>0 THEN LET K$=KEY(2,END=1060,ERR=0700); GOTO 0985
0980 LET K$=STR(IND(2,ERR=1060):"000000"); GOTO 0990
0990 READ RECORD (2,ERR=1060)R$
1000 LET L=POS($0A$=R$); IF L<>0 THEN LET R$(L,1)=$8A$; GOTO 1000
1010 LET L=POS(Z$=R$+Z$)-1
1020 IF L<0 THEN LET L=0
1030 LET O$=K$+$8A$+R$(1,L)
1040 GOSUB 1070
1050 GOTO 0970
1060 RETURN 
1070 REM "3500 - CONVERT DATA"
1080 LET O=1
1090 LET O1=POS("z"<O$(O)); IF O1=0 THEN GOTO 1140
1100 LET O=O+O1-1
1110 IF O$(O,1)=$8A$ THEN LET O$(O,1)="|",O=O+1; GOTO 1090
1120 LET O$=O$(1,O-1)+"~"+HTA(O$(O,1))+O$(O+1),O=O+3
1130 GOTO 1090
1140 LET O=1
1150 LET O1=POS(" ">O$(O)); IF O1=0 THEN GOTO 0490
1160 LET O=O+O1-1
1170 IF O$(O,1)=$8A$ THEN LET O$(O,1)="|",O=O+1; GOTO 1150
1180 LET O$=O$(1,O-1)+"~"+HTA(O$(O,1))+O$(O+1),O=O+3
1190 GOTO 1150
